home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / FIXLIB2.ZIP;1 / LIBFIX2.ZIP / LIBFIX.PRG < prev    next >
Encoding:
Text File  |  1993-03-16  |  13.9 KB  |  475 lines
  1. /****************************************************************************
  2. * FileName..: LibFix.prg
  3. * Author....: Jerry Wightman
  4. * Compuserve: 71075,454 -or- 71545,1244
  5. * Teaks by..: Kevin S. Gallagher
  6. * Compuserve: 70034,2313
  7. * Usage info: See filename --> LibFix.doc
  8. * Compile...: LIBFIX /m/n
  9. * Linkers...: RTlink/Blinker/Warplink
  10. */
  11.  
  12. #include "ksginc.h"
  13.  
  14. STATIC aDisplay :=   { "|", "/", "-", "\" }
  15. STATIC aStat    :=   {}
  16. STATIC CSTR     :=   ""
  17. STATIC old_str  :=   "CLIPPER501"                // Both of these two strings
  18. STATIC new_str  :=   "CLIPPER520"                // most EQUAL in length!!!!!
  19. STATIC IS_CLOCK :=   .F.
  20.  
  21. memvar getlist
  22.  
  23. FUNCTION libfix( file1, file2 )
  24.     local nHandleIn := 0   ,  ;
  25.           nFileOut  := 0   ,  ;
  26.           nBytesIn  := 0   ,  ;
  27.           nBytesOut := 0   ,  ;
  28.           nRow      := 0   ,  ;
  29.           cFileIn   := ""  ,  ;
  30.           cFileOut  := ""  ,  ;
  31.           cBuffer   := ""  ,  ;
  32.           cStrLen   := ""  ,  ;
  33.           nShow     := 0   ,  ;
  34.           nRetVal   := 0   ,  ;
  35.           nReport   := 0   ,  ;
  36.           oldcolor  :=        ;
  37.     SETCOLOR("W+/BG","N/BG")
  38.     
  39.     IF PCOUNT() > 0 .AND. UPPER( ALLTRIM( file1 ) ) $ CmdSpecs
  40.         setcolor("BG+/B")
  41.         //ƒƒƒƒƒ press any key but [ESC] erases the help from the console
  42.         ZoomBox( 5,5,24,76,5,"W+/B",20,"ESC = leave help on screen")
  43.         MoveUp(" This program can be used to replace all occurrences of one series   ")
  44.         MoveUp(" of characters or bytes with the contents of another series.         ")
  45.         MoveUp("                                                                     ")
  46.         MoveUp(" This program is currently compiled to solve a problem with upgrading")
  47.         MoveUp(" third party libraries from Clipper 5.01 to Clipper 5.2.             ")
  48.         MoveUp("                                                                     ")
  49.         MoveUp(" The symbol CLIPPER501 in many libraries needs to be changed to      ")
  50.         MoveUp(" CLIPPER520.  This can be accomplished using this program instead of ")
  51.         MoveUp(" recompiling all of the libraries.                                   ")
  52.         MoveUp("                                                                     ")
  53.         MoveUp(" I suggest first rename the old library with an extension of:  *.L50 ")
  54.         MoveUp(" The program will prompt for the file names for input and output.    ")
  55.         MoveUp("                                                                     ")
  56.         MoveUp(" File names may also be entered on the command line as:              ")
  57.         MoveUp("     LIBFIX  <Input file>  <Output file>                             ")
  58.         MoveUp(" Example:                                                            ")
  59.         MoveUp("     LIBFIX  NANFOR.L50  NANFOR.LIB                                  ")
  60.         MoveUp("")
  61.         setcolor( oldcolor )
  62.         @0,100 say ""
  63.         nRetVal := KG_INKEY(0)
  64.         IF nRetVal <> K_ESC
  65.             InBox(30)
  66.         ENDIF
  67.         @0,0
  68.         ByeBye(.F.)
  69.     ENDIF
  70.     SETCANCEL(.F.)
  71.     SETKEY( ALTC, { |a,b,c| ByeBye( a,b,c ) } )
  72.     ZoomBox( 0,0,MR,MC,8,"W+/B", 0,)
  73.     ZoomBox( 2,1,11,77,4,"N/BG",20,"Press F5 For List of .LIB files",.T.,5)
  74.  
  75.     //ƒƒƒƒƒ install interrupt driven clock...
  76.     #ifdef USE_CLOCK
  77.     IF BK_TICKINS( 2,69 ) == 100
  78.         IS_CLOCK := .T.
  79.     ENDIF
  80.     #endif
  81.  
  82.     @ 3,2 SAY PADC("Program to replace all occurrences",75)   COLOR "GR+/BG"
  83.     @ 4,2 SAY PADC("  of:  " + old_str, 75)                   COLOR "GR+/BG"
  84.     @ 5,2 SAY PADC("with:  " + new_str, 75)                   COLOR "GR+/BG"
  85.  
  86.  
  87.     @ 8,19 SAY " File to convert: " 
  88.     @10,19 SAY "Output file name: " 
  89.  
  90.     IF PCOUNT() > 1 .AND. file( file1 ) .AND. !FILE( file2 )
  91.         cFileIn  := UPPER( PADR(file1,13 ) )
  92.         cFileOut := UPPER( PADR(file2,13 ) )
  93.         @ 8,36  SAY cFileIn                             COLOR "RB+/N,W/N"
  94.         @10,36  SAY cFileOut                            COLOR "RB+/N,W/N"
  95.     ELSE
  96.         SET KEY K_F5 TO LIBFiles()
  97.         cFileIn  := space(13)
  98.         cFileOut := space(13)
  99.     ENDIF
  100.  
  101.     @ 8,36 GET cFileIn   PICTURE "@!"  VALID LIBFiles() COLOR "RB+/N,W/N"
  102.     @10,36 GET cFileOut  PICTURE "@!"                   COLOR "RB+/N,W/N"
  103.     KsgRead()
  104.  
  105.     SET KEY K_F5 TO
  106.  
  107.     cFileIn := TRIM(cFileIn)
  108.     cFileIn += IF( AT(".", cFileIn) == 0, ".LIB", "" )
  109.  
  110.     IF !FILE( cFileIn )
  111.         setcolor( oldcolor )
  112.         ByeBye()
  113.         @MR-1,0 SAY PADR(ERRORMSG1,80)
  114.     ENDIF
  115.  
  116.     cFileOut := TRIM(cFileOut)
  117.     cFileOut += IF( AT(".", cFileOut) == 0, ".LIB", "" )
  118.     IF LEN( cFileOut ) == 4 .AND. cFileOut == ".LIB"
  119.         cFileOut := "51TO52.LIB"
  120.         @10,13 SAY "Defaulting Output to..: "
  121.         @10,36 SAY cFileOut                    COLOR "RB+/N"
  122.     ENDIF
  123.  
  124.     IF( !GetYN("USE THESE SELECTIONS",,"W+/R","W+/R",.T.,.T.),ByeBye(), )
  125.  
  126.     IF FILE( cFileOut ) .AND. cFileOut == cFileIn
  127.         TONE(4000,1)
  128.         GetYN("DUPLICATE FILE NAME","[ QUIT ]",,,.T.,.F.)
  129.         ByeBye()
  130.     ELSEIF FILE( cFileOut ) .AND. cFileOut <> cFileIn
  131.         IF GetYN(cFileOut+" Exist -> Overwrite file",,"W+/R","W+/R",.T.,.T.)
  132.             IF FERASE( cFileOut ) == -1
  133.                 GetYN("ERROR ERASING"+cFileOut,"[ QUIT ]",,,.T.,.F.)
  134.                 ByeBye()
  135.             ENDIF
  136.         ELSE
  137.             ByeBye()
  138.         ENDIF
  139.     ENDIF
  140.  
  141.     IF ( nHandleIn := FOPEN( cFileIn, 16 ) ) < 0
  142.         GetYN("UNABLE TO OPEN ->"+cFileIn,"[ QUIT ]",,,.T.,.F.)
  143.         ByeBye()
  144.     ENDIF
  145.  
  146.     IF ( nFileOut := FCREATE( cFileOut ) ) < 0
  147.         GetYN("ERROR CREATING ->"+cFileOut,"[ QUIT ]",,,.T.,.F.)
  148.         FCLOSE(nHandleIn)
  149.         ByeBye()
  150.     ENDIF
  151.  
  152.     cStr    := SUBSTR(old_str,1)
  153.     cStrLen := LEN(cStr)
  154.     cBuffer := space(1)
  155.  
  156.     FSEEK( nHandleIn , F_BOF )
  157.  
  158.     nBytesIn := 0
  159.     nBytesIn := FREAD( nHandleIn, @cStr, cStrLen )
  160.  
  161.     IF nBytesIn < cStrLen
  162.         EVAL( xBLOCK, nHandleIn,nFileOut,cFileOut )
  163.     ENDIF
  164.  
  165.     nBytesOut := 0
  166.  
  167.     @ MR,0 say PADR("   WORKING ON "+ cFileIn+ " ",80) color "N/BG"
  168.  
  169.     nShow := 0
  170.     #ifndef RollUm
  171.        aStat := StatusNew( MR, 1 ,"W+/BG" )
  172.        @MR,60 say "Found" color   "GR+/BG"
  173.        @MR,67 say "0"     color   "W+/BG"
  174.     #endif
  175.  
  176.     WHILE nBytesIn > 0
  177.         nBytesIn := FREAD( nHandleIn, @cBuffer, 1 )
  178.         IF nBytesIn < 1
  179.             nBytesOut := FWRITE( nFileOut, cStr, cStrLen)
  180.             IF nBytesOut < cStrLen
  181.                 EVAL( xBLOCK, nHandleIn,nFileOut,cFileOut )
  182.             ELSE
  183.                 InBox(10)
  184.                 InBox(10)
  185.                 @0,0 say PADR("SEE "+RPT_FILE+" FOR RESULTS",80) color "N/BG"
  186.             ENDIF
  187.             EXIT
  188.         ENDIF
  189.  
  190.         nBytesOut := FWRITE( nFileOut, LEFT(cStr,1), 1)
  191.         IF nBytesOut <> 1
  192.             EVAL( xBLOCK, nHandleIn,nFileOut,cFileOut )
  193.         ENDIF
  194.  
  195.         cStr := SUBSTR( cStr, 2, cStrLen-1) + cBuffer
  196.  
  197.         nRetVal := Check_It()
  198.         nShow ++
  199.  
  200.         IF nShow > 63
  201.             nShow := 0
  202.             #ifndef RollUm
  203.                StatusUpdate( aStat )
  204.             #endif
  205.             IF(inkey() == K_ESC,EVAL(xBLOCK,nHandleIn,nFileOut,cFileOut),NIL)
  206.         ENDIF
  207.     enddo
  208.  
  209.     FCLOSE(nHandleIn)
  210.     FCLOSE(nFileOut)
  211.  
  212.     IF FILE( RPT_FILE )
  213.         nFileOut := FOPEN( RPT_FILE, FO_READWRITE )
  214.         FSEEK( nFileOut, 0, FS_END )
  215.     ELSE
  216.         nFileOut := FCREATE( RPT_FILE )
  217.         IF FERROR() == 0
  218.             FWriteLine( nFileOut,"" )
  219.             FWriteLine( nFileOut,PADC("-=CONVERSION REPORT FILE=-",78))
  220.             FWriteLine( nFileOut,"" )
  221.         ENDIF
  222.     ENDIF
  223.     IF FERROR() == 0
  224.         FWriteLine( nFileOut, ""                                )
  225.         FWriteLine( nFileOut, REPLICATE(CHR(196),77)            )
  226.         FWriteLine( nFileOut, ""                                )
  227.         FWriteLine( nFileOut, "          Date : " + DTOC( date()))
  228.         FWriteLine( nFileOut, " Original file : " + cFileIn     )
  229.         FWriteLine( nFileOut, "   Output file : " + cFileOut    )
  230.         FWriteLine( nFileOut, " Search string : " + old_str     )
  231.         FWriteLine( nFileOut, "Replace string : " + new_str     )
  232.  
  233.         IF nRetVal == 0
  234.             FWriteLine( nFileOut, "    Occurances : None"       )
  235.         ELSE
  236.             FWriteLine( nFileOut, "    Occurances : " +;
  237.                  ltrim( str( nRetVal );
  238.                 );
  239.             )
  240.         ENDIF
  241.         FWriteLine( nFileOut, ""                                )
  242.     ENDIF
  243.     FCLOSE( nFileOut )
  244.     //ƒƒƒƒƒ Make sure to remove the clock!
  245.     ByeBye()
  246. RETURN NIL
  247.  
  248. FUNCTION error_msg(a,b,c)
  249.     FCLOSE ( a )
  250.     FCLOSE ( b )
  251.     FERASE ( c )
  252.     dispbox(0,0,maxrow(),maxcol(),SPACE(9),"W/N")
  253.     GetYN("FATAL ERROR CAN NOT CONTINUE","[ QUIT ]",,,.T.,.F.)
  254.     ByeBye()
  255. RETURN (NIL)
  256.  
  257.  
  258. FUNCTION Check_It()
  259.     STATIC nCount := 0
  260.  
  261.     IF cStr == old_str
  262.  
  263.         #ifndef TEST
  264.            cStr := new_str
  265.         #endif
  266.  
  267.            nCount ++
  268.         #ifdef RollUm
  269.            ? nCount
  270.            ?? ":  "
  271.            ?? old_str
  272.            ?? " --> "
  273.            ?? new_str
  274.            ?? "  " ;  ?
  275.         #else
  276.            @MR,67 say LTRIM(STR(nCount)) color "W+/BG"
  277.         #endif
  278.     ENDIF
  279.  
  280. RETURN nCount
  281.  
  282.  
  283. /***
  284. *
  285. *  Status.prg
  286. *
  287. *  Implements a moving status indicator that can be used during
  288. *  a batch process to indicate that the process is indeed underway
  289. *
  290. *  Copyright (c) 1993, Computer Associates International Inc.
  291. *  All rights reserved.
  292. *
  293. *  NOTE: Compile with /n /w options
  294. *
  295. */
  296.  
  297. ***
  298. *
  299. *  StatusNew( [<nRow>], [<nCol>], [<oldcolor>] ) --> aStat
  300. *
  301. *  Create a new Status array
  302. *
  303. */
  304. #ifndef RollUm
  305. FUNCTION StatusNew( nRow, nCol, oldcolor )
  306.     LOCAL aStat[ ST_LEN ]
  307.  
  308.     aStat[ ST_ROW     ] := 0
  309.     aStat[ ST_COL     ] := 0
  310.     aStat[ ST_COLOR   ] := "W+/N"
  311.     aStat[ ST_CURRENT ] := 1
  312.  
  313.     IF nRow != NIL
  314.         aStat[ ST_ROW ] := nRow
  315.     ENDIF
  316.  
  317.     IF nCol != NIL
  318.         aStat[ ST_COL ] := nCol
  319.     ENDIF
  320.  
  321.     IF oldcolor != NIL
  322.         aStat[ ST_COLOR ] := oldcolor
  323.     ENDIF
  324. RETURN ( aStat )
  325.  
  326. /***
  327. *
  328. *  StatusUpdate( <aStat> ) --> NIL
  329. *
  330. *  Update screen with new Status position
  331. *
  332. */
  333. FUNCTION StatusUpdate( aStat )
  334.     LOCAL cOldColor
  335.  
  336.     cOldColor := SETCOLOR( aStat[ ST_COLOR ] )
  337.  
  338.     aStat[ ST_CURRENT ]++
  339.     IF aStat[ ST_CURRENT ] > 4
  340.         aStat[ ST_CURRENT ] := 1
  341.     ENDIF
  342.  
  343.     @ aStat[ ST_ROW ], aStat[ ST_COL ] SAY aDisplay[aStat[ ST_CURRENT ]]
  344.  
  345.     SETCOLOR( cOldColor )
  346.  
  347. RETURN ( NIL )
  348. #endif
  349.  
  350. STATIC FUNCTION MoveUp( cText )
  351.     local i, nDelay := 10000
  352.     nDelay -= 9000
  353.     scroll( 6, 6, 23, MAXCOL() -4, 1 )
  354.     @ 23,06 say PADC( cText,70 )
  355.     for i := 1 to ndelay
  356.     next
  357. return nil
  358.  
  359.  
  360. FUNCTION LIBFiles
  361.     local g       := getactive()             ,;
  362.           aDir_   := {}                      ,;
  363.           Files_  := {}                      ,;
  364.           RetVal  := .F.                     ,;
  365.           nChoice := 0                       ,;
  366.           oldscrn := savescreen(9,28,18,53)  ,;
  367.     oldcolor      := setcolor("W+/B,B/W")
  368.  
  369.     SET KEY K_F5 TO
  370.     AEVAL( DIRECTORY("*.LIB"), { | x | AADD( aDir_,x[1] ) } )
  371.     ASORT( aDir_ )
  372.  
  373.     IF LEN(aDir_) <> 0 .AND. EMPTY(RTRIM(g:VarGet())) .OR. LASTKEY() == K_F5
  374.         AADD ( aDir_, "QUIT" )
  375.         DISPBOX(9,28,17,51,"…Õ∏≥Ÿƒ”∫ ")
  376.         @9,32 SAY "µSelect a fileΔ"
  377.         KG_SHADOW(9,28,17,51)
  378.         KEYBOARD CHR( 32 )
  379.         INKEY(0)
  380.         WHILE LASTKEY() <> K_ENTER
  381.             nChoice:=ACHOICE(10,29,16,50, aDir_ )
  382.         ENDDO
  383.  
  384.         IF nChoice == LEN( aDir_ )
  385.             tone(25,1)
  386.         ELSE
  387.             g:varput( PADR(aDir_[nChoice],13) )
  388.             RetVal :=.T.
  389.         ENDIF
  390.     ELSE
  391.         RetVal := IF( FILE( g:VarGet() ),.T.,.F.)
  392.     ENDIF
  393.     SET KEY K_F5 TO LIBFiles()
  394.     
  395.     setcolor(oldcolor)
  396.     restscreen(9,28,18,53,oldscrn)
  397. RETURN RetVal
  398.  
  399. INIT FUNCTION HaHa
  400.     //ƒƒƒƒƒ This type of function was undocumented in 5.1
  401.     set( _SET_SCOREBOARD, .F. )
  402.     set( _SET_CONFIRM   , .T. )
  403.     SETCURSOR( 0 )
  404. RETURN NIL
  405.  
  406. FUNCTION ByeBye( lKill )
  407.     DEFAULT lKill TO .T.
  408.     IF IS_CLOCK
  409.         #ifdef USE_CLOCK
  410.         IF BK_TICKREM() <> 100
  411.             //ƒƒƒƒƒ this message explains it well!
  412.             ALERT("ERROR REMOVING CLOCK;INTERRUPTS ARE CORRUPTED;REBOOT!")
  413.         ELSE
  414.             //ƒƒƒƒƒ This beep signifies that the clock was removed OKay!
  415.             TONE(4000,1)
  416.         ENDIF
  417.         #endif
  418.     ENDIF
  419.     IF lKill
  420.         InBox(10)
  421.         InBox(10)
  422.     ENDIF
  423.     QUIT
  424. RETURN NIL
  425.  
  426.  
  427. /*
  428. * ZoomBox( <nTopRow>,<nTopCol>,<nBotRow>,<nBotCol>,<nBoxType>,<cBoxColor>, ;
  429. *          <nDrawBoxSpeed>, <cTopLineTitle>, <lShadow>, <nShadowColor>     )
  430. *
  431. * This is a quicky on ZoomBox and InBox
  432. * Explode/Implode speed 1-100
  433. * Shadow colors         1-8
  434. *
  435. * EXAMPLE:
  436. * 1. draw a Novell type of backdrop
  437. * 2. Explode a shadow box
  438. * 3. wait for any key
  439. * 4. remove the box
  440. * 5. remove the backdrop
  441. * 
  442. * -------------------------------------------------------------------------*
  443. * ZoomBox( 0,0,maxrow(),maxcol(),8,"W+/BG",50)
  444. * ZoomBox( 10,10,15,70,1,"W+/B",100,"Press a key to implode",.T.,7)
  445. * KG_INKEY(0)
  446. * InBox(100)
  447. * InBox()
  448. * -------------------------------------------------------------------------*
  449. *
  450. * There are 12 box types. Try 1-11 as shown above
  451. *
  452. * Number 12 example:
  453. *
  454. * #define THANDLE1 CHR(213)+CHR(214)
  455. * #define THANDLE2 CHR(215)
  456. *
  457. * FUNCTION TEST
  458. *     SETMODE(25)
  459. *     SETBLINK(.F.)
  460. *     _BOXDEF()
  461. *     // KG_CLS( <nColor>, <cString>)
  462. *     // - cString max length is 18 ( a Clipper internal restriction )
  463. *     KG_CLS( 79,"Clipper5 ")
  464. *     ZoomBox( 3, 3, 20, 76, 12,"W+/B", 15, NIL, .T., 8 )
  465. *     @3,3 SAY PADC("Norton Utils type of boxes",74) COLOR "N/W+*"
  466. *     @3,3 SAY THANDLE1                              COLOR "W+/N"
  467. *     @3,5 SAY THANDLE2                              COLOR "N/W+*"
  468. *     KG_INKEY(0)
  469. *     INBOX( 80 )
  470. *     SETMODE( 25 )
  471. *     CLS
  472. * RETURN NIL
  473. *
  474. */
  475.